home *** CD-ROM | disk | FTP | other *** search
/ Archive Magazine CD 1995 / Archive Magazine CD 1995.iso / discs / prog_disc / volume_7 / issue_10 / adv_basic / !Proggy1 / !RunImage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1994-05-15  |  4.6 KB  |  178 lines
  1.            >!RunImage
  2.  Program   Test Program For Sending a User Message
  3. init             
  4.  quit%:
  5.  start of poll loop                         
  6.  "Wimp_Poll",0,bk% 
  7.  reason%
  8.  reason% 
  9.   2   :
  10.  "Wimp_OpenWindow",,bk%
  11.   3   :
  12.  "Wimp_CloseWindow",,bk%
  13.   6   :
  14. button
  15.   9   :
  16. menuselect
  17.  17,18:
  18. message
  19.  "Wimp_CloseDown"
  20. button
  21.  bk%!8 
  22.  read button state
  23.  bk%!12=-2 
  24. 5     
  25.  if Menu pressed over iconbar, create menu 
  26. 0     
  27.  "Wimp_CreateMenu",,menu%,!bk%-64,184
  28.  bk%!12 
  29.      
  30. ,       
  31.  <SELECT> used on iconbar icon..
  32.        !bk%= mainw%
  33. !(       
  34.  "Wimp_GetWindowState",,bk%
  35.        bk%!28 = -1
  36. #$       
  37.  "Wimp_OpenWindow",,bk%
  38.      
  39.  mainw%
  40. %@       
  41. MessageSend("Proggy2:"+
  42. shell_IconGetData(mainw%,1))
  43. menuselect
  44.  button%
  45.  "Wimp_GetPointerInfo",,bk%+256
  46.  read button state
  47. .+button%=bk%!264                        
  48.  !bk% 
  49.  quit if item 1 chosen
  50. 2$   quit%=
  51.                       
  52.  re-open menu if Adjust was  pressed
  53.  button%=1 
  54.  "Wimp_CreateMenu",,menu%:
  55. message
  56.  bk%!16 
  57. :G                                         
  58.  read message action code
  59.  0:quit%=
  60. :                      
  61.  quit if Quit message received
  62. string(a%)                        
  63.  convert a null-terminated string into CR-terminated
  64.  ?a%<>0
  65.  a$+=
  66. ?a%:a%+=1
  67.  bk% 2000,menu% 75,ind% 2000,name% 11
  68. quit%=0:name$="Proggy1"
  69. err%=0
  70.  "OS_ReadVarVal","Proggy1$Dir",bk%,255,0,3 
  71.  ,,i%
  72. bk%?i%=13:dir$=$bk%
  73.  "Wimp_Initialise",200,&4B534154,name$
  74. error:
  75.  "Wimp_OpenTemplate",,dir$+".Templates"
  76. i%=ind%
  77. infohan%=
  78. create("InfoBox")
  79. mainw%  =
  80. create("mainw")
  81.  "Wimp_CloseTemplate"
  82. U%!bk%=-1:bk%!4=0:bk%!8=0:bk%!12=68
  83. V/bk%!16=68:bk%!20=&3002:$(bk%+24)="!Proggy1"
  84.  "Wimp_CreateIcon",,bk%
  85. setupmenu(menu%)
  86. setupmenu(m%)
  87.  $m%,num%:len%=
  88. ($m%)-2
  89. ]!m%!12=&70207:m%!20=44:m%!24=0
  90. m%+=28:
  91.  i%=1 
  92.  num%
  93.  !m%=-&80*(i%=num%):
  94.  m%!4
  95. `# m%!8=&7009021:
  96.  a$:$(m%+12)=a$
  97. a$>len% len%=
  98.  m%+=24
  99. :menu%!16=16*(len%+1)
  100. create(a$)
  101. $name%=a$
  102.  "Wimp_LoadTemplate",,bk%,i%,ind%+2000,-1,name%,0 
  103.  ,,i%
  104.  "Wimp_CreateWindow",,bk% 
  105.  handle%
  106. =handle%
  107. error
  108. report(
  109. $+" - internal error code "+
  110.  "Wimp_CloseDown"
  111. report(a$,x%)
  112. !bk%=1:$(bk%+4)=a$+
  113.  "Wimp_ReportError",bk%,x%,name$
  114.  Proggy1,2,infohan%,Info,-1,Quit
  115.  --- Memory Management Routines ----------------------------------------
  116. _heap_get(size%)
  117.  ptr%,heap%,flags%
  118.  Returns pointer to new memory block unless claim fails
  119.  in which case -1 is returned
  120.  First find start address of RMA..
  121.  "OS_ReadDynamicArea",1 
  122.  heap%
  123.  Now claim memory, trapping errors by using X form of SWI..
  124.  "XOS_Module",6,,,size% 
  125.  ,,ptr%;flags%
  126.  If error occured return -1, else return address of allocated
  127.  block
  128.  (flags% 
  129.  ptr% = -1
  130. = ptr%
  131. _heap_release(
  132.  ptr%)
  133.  maxfree%,nrpages%,flags%
  134.  Returns  0 if block released OK
  135.  Returns -1 if operation failed (i.e. block doesn't exist)
  136.  "XOS_Module",7,,ptr% 
  137.  ;flags%:
  138.  Free the block
  139.  (flags% 
  140.  1) = 0 
  141.  Block was released successfully...
  142.   ptr% = 0
  143.  Error occured trying to free the block, return -1 to signal to the
  144.  program that something went wrong (normally the program would ignore
  145.  this anyway)
  146.   ptr% = -1
  147. MessageSend(msg$)
  148.  msg_blk%,m_len%
  149. 'm_len%         = (
  150. msg$ + 24) 
  151. 'msg_blk%       = 
  152. _heap_get(m_len%)
  153. -msg_blk%!00    = m_len%:
  154.  Size of message
  155. Imsg_blk%!12    = 0     :
  156.  your_ref (0 = original message not a reply)
  157. 6msg_blk%!16    = &43B00:
  158.  User message reason code
  159.  the 'data' part of the message is simply a zero terminated string..
  160. "$(msg_blk% + 20) = msg$ + 
  161.  send message with reason code 17 (UserMessage, no reply required)
  162.  the 0 passed as the third parameter means broadcast to all tasks..
  163.  "XWimp_SendMessage",17,msg_blk%,0
  164. _heap_release(msg_blk%)
  165. shell_IconGetData(whandle%,ihandle%)
  166.  result$,icon_blk%
  167. icon_blk%=
  168. _heap_get(40)
  169. icon_blk%!0=whandle%
  170. icon_blk%!4=ihandle%
  171.  "Wimp_GetIconState",,icon_blk%
  172.  (icon_blk%!24 
  173.  (1<<8))<>0 
  174.  result$=$(icon_blk%!28) 
  175.  result$=$(icon_blk%+28)
  176. _heap_release(icon_blk%)
  177. =result$
  178.